home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / By the Book / Mac Pascal Primer, 4.0 / Chap 3, Flying Line ƒ / Flying Line.p next >
Text File  |  1990-07-30  |  4KB  |  157 lines
  1. program FlyingLine;
  2.     const
  3.         NUM_LINES = 50;
  4.         NIL_STRING = '';
  5.         NIL_TITLE = '';
  6.         VISIBLE = TRUE;
  7.         NO_GO_AWAY = FALSE;
  8.         NIL_REF_CON = 0;
  9.  
  10.     type
  11.         IntPtr = ^INTEGER;
  12.  
  13.     var
  14.         gLineWindow: WindowPtr;
  15.         gLines: array[1..NUM_LINES] of Rect;
  16.         gDeltaTop, gDeltaBottom: INTEGER;
  17.         gDeltaLeft, gDeltaRight: INTEGER;
  18.         gOldMBarHeight: INTEGER;
  19.         gMBarHeightPtr: IntPtr;
  20.  
  21.  
  22. {-------------------------------->    DrawLine    <---}
  23.  
  24.     procedure DrawLine (i: INTEGER);
  25.     begin
  26.         MoveTo(gLines[i].left, gLines[i].top);
  27.         LineTo(gLines[i].right, gLines[i].bottom);
  28.     end;
  29.  
  30.  
  31. {-------------------------------->    RecalcLine    <---}
  32.  
  33.     procedure RecalcLine (i: INTEGER);
  34.     begin
  35.         gLines[i].top := gLines[i].top + gDeltaTop;
  36.         if ((gLines[i].top < gLineWindow^.portRect.top) | (gLines[i].top > gLineWindow^.portRect.bottom)) then
  37.             gDeltaTop := gDeltaTop * (-1);
  38.         gLines[i].top := gLines[i].top + 2 * gDeltaTop;
  39.  
  40.         gLines[i].bottom := gLines[i].bottom + gDeltaBottom;
  41.         if ((gLines[i].bottom < gLineWindow^.portRect.top) | (gLines[i].bottom > gLineWindow^.portRect.bottom)) then
  42.             gDeltaBottom := gDeltaBottom * (-1);
  43.         gLines[i].bottom := gLines[i].bottom + 2 * gDeltaBottom;
  44.  
  45.         gLines[i].left := gLines[i].left + gDeltaLeft;
  46.         if ((gLines[i].left < gLineWindow^.portRect.left) | (gLines[i].left > gLineWindow^.portRect.right)) then
  47.             gDeltaLeft := gDeltaLeft * (-1);
  48.         gLines[i].left := gLines[i].left + 2 * gDeltaLeft;
  49.  
  50.         gLines[i].right := gLines[i].right + gDeltaRight;
  51.         if ((gLines[i].right < gLineWindow^.portRect.left) | (gLines[i].right > gLineWindow^.portRect.right)) then
  52.             gDeltaRight := gDeltaRight * (-1);
  53.         gLines[i].right := gLines[i].right + 2 * gDeltaRight;
  54.     end;
  55.  
  56.  
  57. {-------------------------------->    MainLoop    <---}
  58.  
  59.     procedure MainLoop;
  60.         var
  61.             i: INTEGER;
  62.  
  63.     begin
  64.         while (not Button) do
  65.             begin
  66.                 DrawLine(NUM_LINES);
  67.                 for i := NUM_LINES downto 2 do
  68.                     gLines[i] := gLines[i - 1];
  69.                 RecalcLine(1);
  70.                 DrawLine(1);
  71.                 gMBarHeightPtr^ := gOldMBarHeight;
  72.             end;
  73.     end;
  74.  
  75.  
  76. {-------------------------------->    Randomize    <---}
  77.  
  78.     function Randomize (range: INTEGER): INTEGER;
  79.         var
  80.             rawResult: LONGINT;
  81.  
  82.     begin
  83.         rawResult := Random;
  84.         rawResult := abs(rawResult);
  85.  
  86.         Randomize := (rawResult * range) div 32768;
  87.     end;
  88.  
  89.  
  90. {-------------------------------->    RandomRect    <---}
  91.  
  92.     procedure RandomRect (var myRect: Rect;
  93.                                     boundingWindow: WindowPtr);
  94.     begin
  95.         myRect.left := Randomize(boundingWindow^.portRect.right - boundingWindow^.portRect.left);
  96.         myRect.right := Randomize(boundingWindow^.portRect.right - boundingWindow^.portRect.left);
  97.         myRect.top := Randomize(boundingWindow^.portRect.bottom - boundingWindow^.portRect.top);
  98.         myRect.bottom := Randomize(boundingWindow^.portRect.bottom - boundingWindow^.portRect.top);
  99.     end;
  100.  
  101.  
  102. {-------------------------------->    LinesInit    <---}
  103.  
  104.     procedure LinesInit;
  105.         var
  106.             i: INTEGER;
  107.  
  108.     begin
  109.         gDeltaTop := 3;
  110.         gDeltaBottom := 3;
  111.         gDeltaLeft := 2;
  112.         gDeltaRight := 6;
  113.  
  114.         HideCursor;
  115.         GetDateTime(randSeed);
  116.         RandomRect(gLines[1], gLineWindow);
  117.         DrawLine(1);
  118.  
  119.         for i := 2 to NUM_LINES do
  120.             begin
  121.                 gLines[i] := gLines[i - 1];
  122.                 RecalcLine(i);
  123.                 DrawLine(i);
  124.             end;
  125.     end;
  126.  
  127.  
  128. {-------------------------------->    WindowInit    <---}
  129.  
  130.     procedure WindowInit;
  131.         var
  132.             totalRect, mBarRect: Rect;
  133.             mBarRgn: RgnHandle;
  134.  
  135.     begin
  136.         gMBarHeightPtr := IntPtr($baa);
  137.         gOldMBarHeight := gMBarHeightPtr^;
  138.         gMBarHeightPtr^ := 0;
  139.         gLineWindow := NewWindow(nil, screenBits.bounds, NIL_TITLE, VISIBLE, plainDBox, WindowPtr(-1), NO_GO_AWAY, NIL_REF_CON);
  140.         SetRect(mBarRect, screenBits.bounds.left, screenBits.bounds.top, screenBits.bounds.right, screenBits.bounds.top + gOldMBarHeight);
  141.         mBarRgn := NewRgn;
  142.         RectRgn(mBarRgn, mBarRect);
  143.         UnionRgn(gLineWindow^.visRgn, mBarRgn, gLineWindow^.visRgn);
  144.         DisposeRgn(mBarRgn);
  145.         SetPort(gLineWindow);
  146.         FillRect(gLineWindow^.portRect, black); {  Change black to ltGray,  }
  147.         PenMode(patXor);    {   <--- and comment out this line  }
  148.     end;
  149.  
  150.  
  151. {-------------------------------->    FlyingLine    <---}
  152.  
  153. begin
  154.     WindowInit;
  155.     LinesInit;
  156.     MainLoop;
  157. end.